Cel

Celem projektu jest określenie jakie mogą być główne przyczyny stopniowego zmniejszania się długości śledzi oceanicznych wyławianych w Europie.

Zbiór danych zostanie wczytany z pliku CSV, następnie musi zostać poddany wstępnemu oczyszczaniu. # Opis zbioru danych Analiza dotyczy zbióru danych na temat połowu śledzia oceanicznego w Europie. Do analizy zebrano pomiary śledzi i warunków w jakich żyją z ostatnich 60 lat. Dane były pobierane z połowów komercyjnych jednostek. W ramach połowu jednej jednostki losowo wybierano od 50 do 100 sztuk trzyletnich śledzi.

Poniżej znajdują się szczegółowe opisy konkretnych atrybutów:

Nazwa kolumny Opis Dodatkowa Informacja
length długość złowionego śledzia [cm]
cfin1 dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1]
cfin2 dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2]
chel1 dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1]
chel2 dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2]
lcop1 dostępność planktonu [zagęszczenie widłonogów gat. 1]
lcop2 dostępność planktonu [zagęszczenie widłonogów gat. 2]
fbar natężenie połowów w regionie [ułamek pozostawionego narybku]
recr roczny narybek [liczba śledzi]
cumf łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]
totaln łączna liczba ryb złowionych w ramach połowu [liczba śledzi]
sst temperatura przy powierzchni wody [°C]
sal poziom zasolenia wody [Knudsen ppt]
xmonth miesiąc połowu [numer miesiąca]
nao oscylacja północnoatlantycka [mb]

Wykorzystane biblioteki

library(knitr)
library(ggplot2)
library(polycor)
library(heatmaply)
library(tidyr)
library(plotly)
library(VIM)
library(caret)
library(klaR)
library(dplyr)

Powtwarzalne wyniki

set.seed(23)

Oczyszczenie danych

Wczytanie danych z pliku CSV

raw_data <- read.csv(file= "sledzie.csv", header= TRUE, sep= ",", na.strings= "?")

Podstawowa analiza arybutów

str(raw_data)
## 'data.frame':    52582 obs. of  16 variables:
##  $ X     : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ length: num  23 22.5 25 25.5 24 22 24 23.5 22.5 22.5 ...
##  $ cfin1 : num  0.0278 0.0278 0.0278 0.0278 0.0278 ...
##  $ cfin2 : num  0.278 0.278 0.278 0.278 0.278 ...
##  $ chel1 : num  2.47 2.47 2.47 2.47 2.47 ...
##  $ chel2 : num  NA 21.4 21.4 21.4 21.4 ...
##  $ lcop1 : num  2.55 2.55 2.55 2.55 2.55 ...
##  $ lcop2 : num  26.4 26.4 26.4 26.4 26.4 ...
##  $ fbar  : num  0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
##  $ recr  : int  482831 482831 482831 482831 482831 482831 482831 482831 482831 482831 ...
##  $ cumf  : num  0.306 0.306 0.306 0.306 0.306 ...
##  $ totaln: num  267381 267381 267381 267381 267381 ...
##  $ sst   : num  14.3 14.3 14.3 14.3 14.3 ...
##  $ sal   : num  35.5 35.5 35.5 35.5 35.5 ...
##  $ xmonth: int  7 7 7 7 7 7 7 7 7 7 ...
##  $ nao   : num  2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...

Zbiór zawiera 52582 rekordów rozmieszczonych w 16 kolumnach (z czego jedna jest kolumną porządkową).

Zmiana kolumn

Zmienna xmonth, która reprezentuje miesiąc połowu powinna zostać zamieniona z ciągłej na kategoryczną, by nie traktować jej jako liczbę. Zmienna totaln, która reprezentuje łączną liczbę ryb złowionych, powinna zostać zmieniona na całkowitą.

raw_data <- raw_data %>% 
  mutate(xmonth= as.factor(xmonth), totaln= round(totaln), totaln= as.integer(totaln))

Problem pustych danych

#Puste dane liczbowo na kolumnę
apply(raw_data, 2, function(x){ sum(is.na(x)) })
##      X length  cfin1  cfin2  chel1  chel2  lcop1  lcop2   fbar   recr 
##      0      0   1581   1536   1555   1556   1653   1591      0      0 
##   cumf totaln    sst    sal xmonth    nao 
##      0      0   1584      0      0      0
#Puste dane procentowo na kolumnę
apply(raw_data, 2, function(x){ sum(is.na(x)) / length(x) })
##          X     length      cfin1      cfin2      chel1      chel2 
## 0.00000000 0.00000000 0.03006732 0.02921152 0.02957286 0.02959188 
##      lcop1      lcop2       fbar       recr       cumf     totaln 
## 0.03143661 0.03025750 0.00000000 0.00000000 0.00000000 0.00000000 
##        sst        sal     xmonth        nao 
## 0.03012438 0.00000000 0.00000000 0.00000000

Zbiór zawiera również wartości puste - te pojawiają się głównie w kolumnach z informacją o dostępności planktonu oraz temperaturze przy powierzchni wody.

aggr(raw_data, plot= TRUE, 
     col= c('#fa9fb5', '#2b8cbe'), 
     numbers= TRUE, 
     prop= FALSE, 
     bars= FALSE, 
     labels= names(raw_data), 
     cex.axis= 0.8, 
     ylab=c("Histogram brakujących danych","Wzorzec"))

Jak zobrazowano na wykresie powyżej, rozkład wartości pustych w kolumnach:

  • cfin1 - dostępność planktonu - skupisko Calanus finmarchicus gat. 1
  • cfin2 - dostępność planktonu - skupisko Calanus finmarchicus gat. 2
  • chel1 - dostępność planktonu - skupisko Calanus helgolandicus gat. 1
  • chel2 - dostępność planktonu - skupisko Calanus helgolandicus gat. 2
  • lcop1 - dostępność planktonu - skupisko widłonogów gat. 1
  • lcop2 - dostępność planktonu - skupisko widłonogów gat. 2
  • sst - temperatura przy powierzchni wody stopnie °C

Usuwając wiersze z wartością NA, utracilibyśby stosunkowo dużo danych - lepszym pomysłem jest zastąpienie wartości brakującej średnią z konkretnego połowu. Bazując na fakcie, iż kolumny totaln, xmonth, nao definiują konkretny połów oraz nie zawierają one żadnych wartości pustych, posłużą one do grupowania. Dane zostały zgrupowane względem połowów, a następnie wartości puste zostały zamienione na średnią z tych połowów.

data <- raw_data %>%
  group_by(totaln, xmonth, nao) %>%
  mutate_each(funs(replace(., which(is.na(.)),
                                mean(., na.rm=TRUE))))

Problem duplikatów

no_x <- data %>% select(-X)
sum(duplicated(no_x))
## [1] 45694

Możemy zaobserwować, iż 45694 rekordów to duplikaty. Pojawiają się one wewnątrz jednego połowu, dlatego usunięcie ich nie wpłynie negatywnie, ani nie sfałszuje danych. Dla uproszczenia grafów oraz dalszych obliczeń, wszystkie duplikaty zostały usunięte, tym samym zbiór danych uszczuplił się do 6888 rekordów.

w_duplicates <- unique(no_x[, 1:15])
w_duplicates <- w_duplicates %>% 
  mutate(X = seq_len(n())) %>% 
  select(X, everything())

Statystyki zbioru danych

Podstawowa analiza arybutów

str(w_duplicates)
## Classes 'grouped_df', 'tbl_df', 'tbl' and 'data.frame':  6888 obs. of  16 variables:
##  $ X     : int  1 2 3 4 5 6 7 1 2 3 ...
##  $ length: num  23 22.5 25 25.5 24 22 23.5 22.5 22 24.5 ...
##  $ cfin1 : num  0.0278 0.0278 0.0278 0.0278 0.0278 ...
##  $ cfin2 : num  0.278 0.278 0.278 0.278 0.278 ...
##  $ chel1 : num  2.47 2.47 2.47 2.47 2.47 ...
##  $ chel2 : num  21.4 21.4 21.4 21.4 21.4 ...
##  $ lcop1 : num  2.55 2.55 2.55 2.55 2.55 ...
##  $ lcop2 : num  26.4 26.4 26.4 26.4 26.4 ...
##  $ fbar  : num  0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 0.356 ...
##  $ recr  : num  482831 482831 482831 482831 482831 ...
##  $ cumf  : num  0.306 0.306 0.306 0.306 0.306 ...
##  $ totaln: int  267381 267381 267381 267381 267381 267381 267381 267381 267381 267381 ...
##  $ sst   : num  14.3 14.3 14.3 14.3 14.3 ...
##  $ sal   : num  35.5 35.5 35.5 35.5 35.5 ...
##  $ xmonth: Factor w/ 12 levels "1","2","3","4",..: 7 7 7 7 7 7 7 6 6 6 ...
##  $ nao   : num  2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 2.8 ...
##  - attr(*, "vars")=List of 3
##   ..$ : symbol totaln
##   ..$ : symbol xmonth
##   ..$ : symbol nao
##  - attr(*, "labels")='data.frame':   551 obs. of  3 variables:
##   ..$ totaln: int  144137 144137 144137 144137 144137 144137 144137 144137 144137 147332 ...
##   ..$ xmonth: Factor w/ 12 levels "1","2","3","4",..: 2 3 4 5 6 7 8 9 10 2 ...
##   ..$ nao   : num  0.17 0.17 0.17 0.17 0.17 0.17 0.17 0.17 0.17 2.52 ...
##   ..- attr(*, "vars")=List of 3
##   .. ..$ : symbol totaln
##   .. ..$ : symbol xmonth
##   .. ..$ : symbol nao
##   ..- attr(*, "drop")= logi TRUE
##  - attr(*, "indices")=List of 551
##   ..$ : int  3403 3404 3405 3406 3407 3408 3816 3831 3879 3920 ...
##   ..$ : int  3398 3399 3400 3401 3402
##   ..$ : int  3412 3413 3414 3415 3416 3417 3914 3929 4134 4135 ...
##   ..$ : int  3827 3828 3829 3830 3881 3963 3964 3965 3966 3983
##   ..$ : int  3334 3759 3760 3780 3781 3782 3787 3788 3794 3795 ...
##   ..$ : int  3348 3754 3755 3766 3767 3768 3785 3786 3820 3877
##   ..$ : int  3778 3779 3783 3784 3791 3792 3793 3813 3814 3815 ...
##   ..$ : int  3335 3336 3346 3347 3874 3875 3876 3878 3880
##   ..$ : int  3409 3410 3411 3427 3428 3429 3430
##   ..$ : int  2900 2901 2904 2905 2906 2907 2936 2937
##   ..$ : int  2888 2889 2890 2891 2892 2893 2894 2895 2899 3951 ...
##   ..$ : int  3977 3978
##   ..$ : int  2838 2839 2840 2841 2842 2852 2853 2873 2898 2902 ...
##   ..$ : int  2819 2820 2832 2833 2834 2835 2836 2837 2908 2909 ...
##   ..$ : int  2823 2824 2825 2826 2876 2877 2880 2881 2882 2883 ...
##   ..$ : int  3987 3988 4009 4129 4174
##   ..$ : int  3900 3901 3902 3903 3904 3905 3906
##   ..$ : int  2996 3018 3019 3020 3021 3022 3023 3854 3855 3857 ...
##   ..$ : int  3087 3089 3090 3091 3092
##   ..$ : int  3096 3097 3098 3099 3100 3102 3103 3104 3105 3106 ...
##   ..$ : int  3138 3139 3140 3141 3142 3143 3832 3833 3835 3899
##   ..$ : int  3028 3029 3030 3031 3032 3033 3062 3848 3849 3850
##   ..$ : int  3063 3064 3065 3066 3073 3074 3075 3079 3080 3081 ...
##   ..$ : int  3024 3025 3026 3027 3055 3056 3057 3058 3083 3084 ...
##   ..$ : int  3059 3060 3061 3070 3071 3072 3076 3077 3078 3088 ...
##   ..$ : int  3093 3124 3125 3126 3144 3145 3146 3147 3237 3345 ...
##   ..$ : int  3907 3908 3909 3910 3911 3930 3931 3932 3933 3934 ...
##   ..$ : int  2854 2855 2856 2857 2858 2859 2946 2947
##   ..$ : int  3680 3683 3684
##   ..$ : int  2948 2949 2950 2951 3957 3958 3959 3972
##   ..$ : int  5673 5674 5680 5681 5682 5683
##   ..$ : int  3821 3822 3823 3824 3825 3826 3967 3985
##   ..$ : int  2926 2927 2928 3682 3953 3954 3955 3956 3969 3970
##   ..$ : int  2930 3685 3686 3687 3694 3695 4091 4127
##   ..$ : int 3986
##   ..$ : int  4052 4074 4075 4076 4077
##   ..$ : int  3042 3043 3044 3045 3046 3047 3048 3049 3069
##   ..$ : int  3067 3068 3086
##   ..$ : int  4036 4037
##   ..$ : int  2963 2988 2989 2990 2991 2992 2993 2994 2995 3971 ...
##   ..$ : int  3975 3976 4010 4023 4024
##   ..$ : int  2939 2940 2941 2942 2943 2944 2945 2982 3950 3990
##   ..$ : int  2956 2957 2958 2959 2960 2961 2962 2983
##   ..$ : int  2984 2985 2986 2987 3001 3002 3003 3004 3005 3006
##   ..$ : int  3128 3129 3130 3131 3132 3133 3134 3135 3688 3837 ...
##   ..$ : int  3034 3035 3036 3037 3038 3039 3040 3041 3711 3712 ...
##   ..$ : int  3852 3853 3937 3938 3939 3940 3960 3961
##   ..$ : int  3165 3293 3294 3295 3296 3297 4045 4046 4047 4048
##   ..$ : int  3179 3180 3181 3182 3183 3203 3222 3223 3224 3229 ...
##   ..$ : int  3386 3387 3388 3389 3391 3392 3393 3394 3395
##   ..$ : int  3315 3316 3317 3318 3319 3320 3321 3322 3609
##   ..$ : int  3238 3239 3240 3241 3242 3243 3244 3360 3361 3521 ...
##   ..$ : int  3362 3363 3364 3365 3366 3384 3385 3843 3844 3851 ...
##   ..$ : int  3161 3162 3163 3164 3167 3175 3176 3177 3178 3184 ...
##   ..$ : int  3189 3190 3191 3192 3193 3194 3195 3202 4011 4012
##   ..$ : int  3566 3567 3568 3569 3570 3571 3572 3573
##   ..$ : int  3185 3186 3187 3188 3196 3197 3198 3199 3200 3201 ...
##   ..$ : int  3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 ...
##   ..$ : int  4004 4005 4006 4007 4008 4014
##   ..$ : int  4042 4043 4044 4067 4068 4069 4070 4071 4072
##   ..$ : int  4131 4172 4173 4275
##   ..$ : int  4099 4100 4107 4108 4120 4121 4122 4123 4124 4133
##   ..$ : int  4094 4095 4096 4097 4101 4102 4103 4104 4105 4106 ...
##   ..$ : int  4199 4335 4336 4337 4835 4836 4837 4846 4847
##   ..$ : int  4049 4050 4603 4604 4605 4624 4625 5203 5211 5212 ...
##   ..$ : int  4112 4113 4114 4115 4116 4117 4118 4119 4125 4126 ...
##   ..$ : int  4850 4851 4852 4853 4854 4855 4856 4857 4879
##   ..$ : int  4715 4716 4717 4718 4719 4720 4721 4725 4726 5072
##   ..$ : int  4690 4691 4692 4693 4694 4695 4696 4796 4800
##   ..$ : int  4161 4162 4163 4164 4829 4830 4831 4832 5197 5198 ...
##   ..$ : int  4026 4027 4028
##   ..$ : int  1129 1130 4196 4197 4198
##   ..$ : int  6878 6884 6885 6886
##   ..$ : int  415 416 426 427 428
##   ..$ : int  360 361 362 392 429 629 630 701 702 715 ...
##   ..$ : int  76 77 78 79 85 151 1391 1537
##   ..$ : int  1538 1539 4018 4019 4020 4021 4022 4289 4601 4602
##   ..$ : int  3947 3948 3968 4015 4017 4033 4051 4175 4178 4179 ...
##   ..$ : int  1147 1148 1149 1150 1151 4177
##   ..$ : int  1105 1106 1107 1108 1109 1110 1111 1112 4013 4016
##   ..$ : int  4057 4058 4059 4060 4061 4062 4063 4064 4065 4066
##   ..$ : int  1131 4029 4030 4031 4176 4181 4182
##   ..$ : int  3979 3980 3981 3982 3989
##   ..$ : int  2789 2790 2791 2792 2885 2886 2887 3597 3598
##   ..$ : int  3799 3800 3801 3802 3803 3804 3811 3812
##   ..$ : int  2829 2830 2831 2844 2845 2846 3923 3924 3925 4157 ...
##   ..$ : int  3927 3928 4109 4110 4111 4132
##   ..$ : int  2745 2746 2747 2748 2749 2750 2788 3915 3919 3962 ...
##   ..$ : int  2763 2764 2765 2766 2767 2768 2769 3127 3158 3159 ...
##   ..$ : int  2847 2848 2849 2850 2851 2869 2870 2871 2872 2896 ...
##   ..$ : int  2724 2725 2739 2740 2741 2742 2743 2744 3599
##   ..$ : int  2751 2752 2753 2756 2757
##   ..$ : int  3668 3669 3670 3671 3672 3673 3674 3675 3676
##   ..$ : int  3525 3526 3527 3528 3529 3530 3531 3533 3564 4000 ...
##   ..$ : int  3349 3350 3351 3352 3353 3354 3355 3891 3892 3893 ...
##   ..$ : int  3513 3514 3515 3516 3517 3518 3519 3520
##   ..$ : int  3534 3535 3536 3537 3538 3539 3560 3561 3562 3563 ...
##   ..$ : int  3418 3419 3420 3421 3422 3423 3424 3425 3426 3433 ...
##   ..$ : int  3805 3806 3807 3808 3809 3810 3817 3818 3868 3869
##   .. [list output truncated]
##  - attr(*, "drop")= logi TRUE
##  - attr(*, "group_sizes")= int  11 5 11 10 18 10 14 9 7 8 ...
##  - attr(*, "biggest_group_size")= int 186

Zbiór danych po oczyszczaniu zmniejszył się do 6888 wierszy, liczba kolumn pozostała niezmieniona i wynosi 16. ## Analiza arybutów

knitr::kable(summary(w_duplicates))
X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr cumf totaln sst sal xmonth nao
Min. : 1.00 Min. :19.00 Min. : 0.00000 Min. : 0.0000 Min. : 0.000 Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680 Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77 Min. :35.40 8 : 879 Min. :-4.89000
1st Qu.: 4.00 1st Qu.:24.00 1st Qu.: 0.02778 1st Qu.: 0.2500 1st Qu.: 2.469 1st Qu.:15.030 1st Qu.: 2.5479 1st Qu.:20.094 1st Qu.:0.1580 1st Qu.: 364794 1st Qu.:0.11008 1st Qu.: 307276 1st Qu.:13.64 1st Qu.:35.51 10 : 879 1st Qu.:-1.69000
Median : 7.00 Median :25.50 Median : 0.14158 Median : 0.3714 Median : 4.811 Median :21.435 Median : 5.9167 Median :24.859 Median :0.3320 Median : 459347 Median :0.21476 Median : 539558 Median :13.98 Median :35.51 7 : 747 Median : 0.20000
Mean : 15.72 Mean :25.32 Mean : 0.55913 Mean : 1.7403 Mean : 8.801 Mean :21.157 Mean : 11.3557 Mean :27.683 Mean :0.3202 Mean : 543028 Mean :0.21417 Mean : 523418 Mean :13.94 Mean :35.52 9 : 680 Mean : 0.08938
3rd Qu.: 12.00 3rd Qu.:26.50 3rd Qu.: 0.36032 3rd Qu.: 1.5701 3rd Qu.: 9.667 3rd Qu.:26.324 3rd Qu.: 12.4959 3rd Qu.:35.153 3rd Qu.:0.4250 3rd Qu.: 774993 3rd Qu.:0.28116 3rd Qu.: 763083 3rd Qu.:14.21 3rd Qu.:35.52 6 : 559 3rd Qu.: 1.80000
Max. :186.00 Max. :32.50 Max. :37.66667 Max. :19.3958 Max. :75.000 Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490 Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73 Max. :35.61 5 : 521 Max. : 5.08000
NA NA NA NA NA NA NA NA NA NA NA NA NA NA (Other):2623 NA

Rozklad wartosci

data_dist <- w_duplicates %>% 
  select(-X) %>% 
  melt

ggplot(data_dist, aes(x= value)) + 
  geom_density(fill= "#2b8cbe") + 
  facet_wrap(~variable, scales= "free") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

Zmienne, poza length, nie mają rozkładu normalnego.

Korelacja zmiennych

heatmaply(hetcor(as.data.frame(w_duplicates)), k_col = 2, k_row = 3)

Z powodu różnych klas kolumn, np. xmonth jest zmienną kategoryczną, length ciągłą a X porządkową. Została wyliczona heterogeniczna macierz korelacji, metodą hetcor z biblioteki ploycor.

Wykres po czasie

p <- ggplot(w_duplicates, aes(x= X, y= length)) +
  geom_line(alpha= 0.3) +
  geom_smooth(method= "gam", formula= y ~ s(x, k= 100), size= 1) +
  ggtitle("Zmiana rozmiaru złowionego śledzia w czasie")

ggplotly(p)

Jako, że dane zostały uporządkowane chronologicznie, długość śledzia w czasie prezentowany jest przy użyciu liczby porządkowej X. Z powodu ilości danych, który znacznie obniża czytelność wykresu, została zastosowana metoda smooth, która pozwoli na odkrycie ogólnego wzorca. Użycie wygładzenia liniowego, nie byłoby dostatecznie odpowiednie dla zebranego zestawu danych, dlatego został użyty uogólniony model addytywny gam.

Największa korelacja dotyczy par opisujących planktony, lcop1 i chel1 oraz lcop2 i chel2. Duży współczynnik korelacji pomiędzy cumf oraz totaln, przez co możemy wnioskować, iż wraz ze wzrostem łącznej liczby ryb złowionych w połowie rośnie natężenie połowów. Co więcej możemy zaobreswować korelację pomiędzy cumf oraz fbar - łączne roczne natężenie połowów było wysokie tak samo jak ich intensywność.

Regresor

Regresor ma za zadanie przewidzieć rozmiary śledzia w kolejnych połowach. Dane zostały podzielone na dwa zbiory: uczący i testowy, z czego 75% całego zbioru zostało potraktowane jako uczące. Uczenie odbyło się przy użyciu metody Repeated Cross-Validation, z powodu niewielkich różnic wartości w zbiorze zastosowano liczbę powtórzeń na poziomie 5 z liczbą powtórzen 2. Model jest tworzony w opariu o model klasyfikacyjny Random Forrest.

fit <- lm(length ~ ., data = no_x)

# Miara R^2
summary(fit)$r.squared 
## [1] 0.3315561
# Błąd średnio-kwadratowy
rmse <- function(num) sqrt(sum(num^2)/length(num))
rmse(fit$residuals)
## [1] 1.351338
inTraining <- 
    createDataPartition(
        y = no_x$length,
        p = 0.75,
        list = FALSE)

training <- no_x[ inTraining,]
testing  <- no_x[-inTraining,]

ctrl <- trainControl(
    method = "repeatedcv",
    number = 2,
    repeats = 5)

fit <- train(length ~ .,
             data = training,
             method = "rf",
             trControl = ctrl,
             ntree = 2)
## Loading required package: randomForest
## randomForest 4.6-12
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## The following object is masked from 'package:dplyr':
## 
##     combine
## The following object is masked from 'package:ggplot2':
## 
##     margin
fit
## Random Forest 
## 
## 39438 samples
##    14 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times) 
## Summary of sample sizes: 19719, 19719, 19720, 19718, 19718, 19720, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared 
##    2    1.179349  0.4903080
##   13    1.155392  0.5115404
##   24    1.157489  0.5099190
## 
## RMSE was used to select the optimal model using  the smallest value.
## The final value used for the model was mtry = 13.
plot(fit)

rfClasses <- predict(fit, newdata = testing)
summary(rfClasses)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   22.09   24.56   25.35   25.31   26.24   28.57
df<-data.frame(rfClasses)
ggplot(df, aes_string(x = rfClasses)) + 
  geom_histogram(bins= 100, fill= "#0087BD")  + 
  ggtitle("Przewidywany rozmiar śledzia") + 
  theme_bw() + 
  labs(x= "Rozmiar śledzi", y="Liczba")

Analiza waznosci atrybutów

fit_rf <- randomForest(length ~ ., no_x)
fit_rf
## 
## Call:
##  randomForest(formula = length ~ ., data = no_x) 
##                Type of random forest: regression
##                      Number of trees: 500
## No. of variables tried at each split: 4
## 
##           Mean of squared residuals: 1.319012
##                     % Var explained: 51.72
importance_df <- importance(fit_rf)
importance_df <- data.frame(var = rownames(importance_df), importance = importance_df[, 1])
importance_df$var <- factor(importance_df$var, levels = importance_df[order(importance_df$importance), "var"])

ggplot(importance_df, aes(x = var, y = importance)) +
  geom_bar(stat = "identity", fill = "#2b8cbe") + 
  ggtitle("Ważność zmiennych") + 
  theme_bw()

ggplot(data, aes(x = length, y = sst)) + 
  geom_smooth() + 
  ggtitle("Zależność długości śledzia od temperatury przy powierzchni wody") + 
  theme_bw()
## `geom_smooth()` using method = 'gam'

Jak możemy zaobserwować na powyższym wykresie, długość śledzia maleje wraz ze wzrostem temperatury przy powierzchni wody.

ggplot(data, aes(X, sst)) + 
  geom_smooth() + 
  theme_bw() + 
  ggtitle("Zmiana temperatury wody w czasie") + 
  labs(x= "Czas - l.porzadkowa", y="Temperatura[°C]")
## `geom_smooth()` using method = 'gam'

Natomiast temperatura rosła przez ostatnie lata, co spowodowało znaczne obniżenie długości wyławianych śledzi.

ggplot(data, aes(X, nao)) + 
  geom_smooth() + 
  theme_bw() + 
  ggtitle("Zmiana Oscylacji Północnoatlantyckiej w czasie") + 
  labs(x= "Czas - l.porzadkowa", y="Oscylacja Północnoatlantycka")
## `geom_smooth()` using method = 'gam'

Podsumowanie

Konkludując powyższe informacje, możemy postawić diagnozę problemu - w ostatnich latach znacznie wzrosła temperatura przy powierzchni wody, co negatywnie wpłynęło na długość wyławianego śledzia. Wpływ na to ma również zmiana oscylacji północnoatlantyckiej - jest to zjawisko związane z globalną cyrkulacją powietrza i wody oceanicznej, ujawnia się poprzez fluktuacje takich parametrów, jak ciśnienie, temperatura, prędkość wiatru, ilość opadów.